home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 24 / Amiga Format AFCD24 (Feb 1998, Issue 108).iso / -seriously_amiga- / shareware / programming / amos / transi / t1.amos / t1.amosSourceCode < prev   
AMOS Source Code  |  1998-01-05  |  7KB  |  278 lines
  1. 'Start check 
  2. Data 7818,7638,9186
  3. Hide On : Curs Off : Flash Off : Print 
  4. For BANK=5 To 7
  5.    Read SHOULD_BE : IS=Length(BANK)
  6.    If SHOULD_BE<>IS Then FAIL=True : Print "Bank";BANK;" is";IS
  7. Next 
  8. If FAIL
  9.    Print : Print "Someone changed the graphics!"
  10.    Print "This could get ugly."
  11.    Print : Print "Want to continue anyway?"
  12.    Do 
  13.       A$="" : While A$=""
  14.          A$=Upper$(Inkey$)
  15.       Wend 
  16.       If A$="Y" : Goto MAIN : End If 
  17.       If A$="N" : Goto QUIT : End If 
  18.    Loop 
  19. End If 
  20. '
  21. 'Finished checking graphics
  22. '
  23. MAIN:
  24. Dim FARGER(31,2,1) : Rem  Used by effect E  
  25. Global FARGER(),LAYER
  26. '
  27. Auto View Off 
  28. Screen Open 2,16,16,32,0 : Screen Hide 2 : Flash Off 
  29. THIS_ONE=6 : THAT_ONE=7 : SEEN=0 : UNSEEN=1
  30. Unpack 5 To SEEN : Unpack THIS_ONE To UNSEEN : Screen To Front SEEN
  31. Auto View On 
  32. '
  33. 'Prepare data for P effect ''''''''''''''''''''''''''''''''''''''''''''''''''
  34. XER=Screen Width/16 : YER=Screen Height/16 : XYER=(XER*YER)-1
  35. Dim X(XYER),Y(XYER)
  36. X=0 : Y=0 : For A=0 To XYER
  37.    X(A)=X : Y(A)=Y
  38.    Add X,1,0 To XER-1 : If X=0 : Inc Y : End If 
  39. Next 
  40. For SHUFFLE=1 To 5
  41.    For A=0 To XYER
  42.       Repeat 
  43.          B=Rnd(XYER)
  44.       Until B<>A
  45.       Swap X(A),X(B) : Swap Y(A),Y(B)
  46.    Next 
  47. Next 
  48. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  49. '  
  50. 'Select-an-effect loop starts
  51. Do 
  52.    Follow Off 
  53.    A$="" : While A$=""
  54.       A$=Upper$(Inkey$)
  55.       If Key Shift=8 Then Gosub CTRL
  56.    Wend 
  57.    If A$=Chr$(27)
  58.       QUIT: Screen UNSEEN : Paper 1 : Pen 0 : Cls 
  59.       Print At(8,16);"That's all for now then!"
  60.       On FX Gosub A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z
  61.       End 
  62.    End If 
  63.    FX=Asc(A$)-64 : On FX Gosub A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z
  64.    If OK
  65.       'Clean up ready for next 
  66.       Auto View Off 
  67.       Swap THIS_ONE,THAT_ONE : Unpack THIS_ONE To UNSEEN
  68.       Screen To Back UNSEEN : Auto View On 
  69.       OK=False : OFX=FX
  70.    End If 
  71. Loop 
  72. '
  73. '
  74. CTRL:
  75. 'This is a simpler way to switch back and forth between Amos and WB  
  76. While Key Shift<>0 : Wend 
  77. Amos To Back 
  78. While Key Shift<>8 : Wend 
  79. While Key Shift<>0 : Wend 
  80. Amos To Front : Return 
  81. '
  82. A: Rem Simple cut 
  83. Screen To Front UNSEEN : Swap SEEN,UNSEEN : OK=True
  84. Return 
  85. '
  86. B: Rem Fade to black and cut  
  87. Screen SEEN : Fade 5
  88. Repeat : Until Colour(1)=0 : Wait 10 : Goto A
  89. '
  90. C: Rem Fade to black and back up
  91. Screen 2 : Get Palette UNSEEN
  92. Screen UNSEEN
  93. For A=0 To Screen Colour-1 : Colour A,0 : Next 
  94. Gosub B : Rem Fade to black and cut
  95. Screen SEEN : Fade 5 To 2
  96. Repeat : Until Colour(1)=4095
  97. Return 
  98. '
  99. D: Rem Fast fade to white and back  
  100. Screen 2
  101. For A=0 To 31 : Colour(A),4095 : Next 
  102. Screen SEEN : Fade 1 To 2
  103. Repeat : Until Colour(0)=4095
  104. Screen 2 : Get Palette UNSEEN
  105. Screen UNSEEN : Get Palette SEEN
  106. Gosub A : Fade 1 To 2
  107. Repeat : Until Colour(0)=0
  108. Return 
  109. '
  110. E: Rem Flash over (Uses array dimensioned and globalized under MAIN:) 
  111. FINDCOLOURS[SEEN] : FINDCOLOURS[UNSEEN]
  112. For A=0 To Screen Colour-1 : Colour(A),$FFF : Next 
  113. Screen SEEN : FAD[True]
  114. Gosub A : Rem Cut
  115. Screen SEEN : FAD[False]
  116. Return 
  117. '' Procedures used by the above: 
  118. Procedure FINDCOLOURS[LAYER]
  119.    Screen LAYER : ANTFAR=Screen Colour
  120.    If ANTFAR>32
  121.       Default : Locate ,12 : Curs Off 
  122.       Centre "Screen"+Str$(LAYER)+" is too deep -"+Str$(ANTFAR)+" colours!"
  123.       End 
  124.    End If 
  125.    For A=0 To ANTFAR-1
  126.       RGB=Colour(A)
  127.       FARGER(A,0,LAYER)=RGB
  128.       'Time for some arithmetics 
  129.       FARGER(A,2,LAYER)=$FFF
  130.       R=RGB and $F00 : G=RGB and $F0 : B=RGB and F
  131.       Add R,$F00 : Add G,$F0 : Add B,$F
  132.       R=R/2 : G=G/2 : B=B/2
  133.       R=R and $F00 : G=G and $F0 : B=B and F
  134.       FARGER(A,1,LAYER)=R+G+B
  135.    Next 
  136. End Proc
  137. Procedure FAD[OPP]
  138.    If OPP Then _START=0 Else _START=2
  139.    _SLUTT=2-_START : _STEG=Sgn(_SLUTT-_START)
  140.    For A=_START To _SLUTT Step _STEG
  141.       For B=0 To Screen Colour-1 : Colour B,FARGER(B,A,Screen)
  142.       Next : Wait 3 : Wait Vbl 
  143.    Next 
  144. End Proc
  145. '
  146. F: Rem Roll over Beethoven  
  147. Auto View Off 
  148. Screen Display UNSEEN,,,,0
  149. Auto View On 
  150. Gosub A
  151. For A=1 To Screen Height : Screen Display SEEN,,,,A : Wait Vbl : Next 
  152. Return 
  153. '
  154. G: Rem The other way round
  155. For A=Screen Height To 0 Step -1 : Screen Display SEEN,,,,A : Wait Vbl : Next 
  156. Gosub A
  157. Return 
  158. '  
  159. H: Rem Or combine the two 
  160. S0=Y Hard(0)
  161. SH=Screen Height/2
  162. Auto View Off 
  163. Screen Display UNSEEN,,SH,,0
  164. Auto View On 
  165. Gosub A
  166. For A=1 To SH : Screen Display SEEN,,S0+SH-A,,A*2 : Wait Vbl : Next 
  167. Return 
  168. '
  169. I: Rem ...with a third
  170. S0=Y Hard(0)
  171. SH=Screen Height/2
  172. Auto View Off 
  173. Screen Display UNSEEN,,SH,,0 : Screen Offset UNSEEN,,SH
  174. Auto View On 
  175. Gosub A
  176. For A=1 To SH
  177.    Screen Display SEEN,,S0+SH-A,,A*2
  178.    Screen Offset SEEN,,SH-A
  179.    Wait Vbl 
  180. Next 
  181. Return 
  182. '
  183. '
  184. 'End of screen image transitions 
  185. 'Start of screen data transitions
  186. '
  187. '
  188. SIMILAR: Rem Check if pictures are similar for data transitions 
  189. Screen SEEN : SW1=Screen Width : SH1=Screen Height : SC1=Screen Colour
  190. Screen UNSEEN : SW2=Screen Width : SH2=Screen Height : SC2=Screen Colour
  191. If SW1<>SW2 or SH1<>SH2 or SC1<>SC2
  192.    Default : Print "Mismatch!!"
  193.    Print 
  194.    Print "SW1=";SW1,"SW2=";SW2
  195.    Print "SH1=";SH1,"SH2=";SH2
  196.    Print "SC1=";SC1,"SC2=";SC2
  197.    End 
  198. End If 
  199. Return 
  200. '
  201. J: Rem Built-in Appear  
  202. Gosub SIMILAR
  203. Appear UNSEEN To SEEN,133 : OK=True
  204. Return 
  205. '
  206. K: Rem Growing square 
  207. Gosub SIMILAR
  208. W2=SW1/2 : W1=W2-1
  209. H2=SH1/2 : H1=H2-1
  210. For A=1 To W2
  211.    Screen Copy UNSEEN,W1,H1,W2,H2 To SEEN,W1,H1 : Wait Vbl 
  212.    Dec W1 : Dec H1 : Inc W2 : Inc H2
  213. Next : OK=True
  214. Return 
  215. '
  216. L: Rem Plain wipe 
  217. Gosub SIMILAR
  218. For A=0 To SW1-1
  219.    Screen Copy UNSEEN,A,0,A+1,SH1 To SEEN,A,0 : Wait Vbl 
  220. Next : OK=True
  221. Return 
  222. '
  223. M: Rem Double wipe
  224. Gosub SIMILAR
  225. For A=0 To SW1/2 : B=SW1-A
  226.    Screen Copy UNSEEN,A,0,A+1,SH1 To SEEN,A,0
  227.    Screen Copy UNSEEN,B,0,B+1,SH1 To SEEN,B,0 : Wait Vbl 
  228. Next : OK=True
  229. Return 
  230. '
  231. N: Rem Fancy wipe 
  232. Gosub SIMILAR
  233. For A=0 To SW1-4 Step 2 : B=SW1-A-3
  234.    Screen Copy UNSEEN,A,0,A+1,SH1 To SEEN,A,0
  235.    Screen Copy UNSEEN,B,0,B+1,SH1 To SEEN,B,0 : Wait Vbl 
  236. Next : OK=True
  237. Return 
  238. '
  239. O: Rem The same horizontally
  240. Gosub SIMILAR
  241. For A=0 To SH1-4 Step 2 : B=SH1-A-3
  242.    Screen Copy UNSEEN,0,A,SW1,A+1 To SEEN,0,A
  243.    Screen Copy UNSEEN,0,B,SW1,B+1 To SEEN,0,B : Wait Vbl 
  244. Next : OK=True
  245. Return 
  246. '
  247. P: Rem 16-squares (uses array prepared under MAIN:) 
  248. Gosub SIMILAR
  249. For A=0 To XYER
  250.    X1=X(A)*16 : Y1=Y(A)*16 : X2=X1+16 : Y2=Y1+16
  251.    Screen Copy UNSEEN,X1,Y1,X2,Y2 To SEEN,X1,Y1 : Wait Vbl 
  252. Next : OK=True
  253. Return 
  254. '
  255. Q: Rem Here's a brand new one I just thought up 
  256. Gosub SIMILAR
  257. SEC1=SH1/3 : SEC2=SEC1*2
  258. For A=0 To SW1-1 : B=SW1-A
  259.    Screen Copy UNSEEN,A,0,A+1,SEC1 To SEEN,A,0
  260.    Screen Copy UNSEEN,B,SEC1,B+1,SEC2 To SEEN,B,SEC1
  261.    Screen Copy UNSEEN,A,SEC2,A+1,SH1-1 To SEEN,A,SEC2
  262. Next : OK=True
  263. Return 
  264. '
  265. R:
  266. S:
  267. T:
  268. U:
  269. V:
  270. W:
  271. X:
  272. Y:
  273. Z: Rem The Return below is here just to catch the rest of the alphabet. 
  274. '          [The labels above are just so the On Goto won't crash.] 
  275. '
  276. FX=OFX : If FX=0 Then FX=Rnd(10)+5 : Rem To make sure it ends with an effect. 
  277. Return 
  278. '****************************************************************************